home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 039a / artcpy20.zip / SAMPLE1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-11-13  |  9KB  |  316 lines
  1. (*  =======================================================================
  2.     SAMPL1.PAS
  3.  
  4.     This is a sample of a PASCAL program which uses BGIPrint drivers.
  5.     It uses portions of Borland's BGI Demo to illustrate the compatibility
  6.     of BGI Print with screen drivers.
  7.  
  8.     Please note the use of calculated x-y coordinates based on values
  9.     returned by GETMAXX and GETMAXY.
  10.  
  11.     To run this sample, ensure that the BGIPrint drivers are in the
  12.     current directory along with the CHR files supplied with Turbo Pascal
  13.  
  14.     ====================================================================== *)
  15.  
  16.  
  17. Uses CRT,DOS,Graph;
  18.   var
  19.     Driver, Mode, TestDriver,
  20.     ErrCode  : Integer;
  21.     MAxX,MaxY,MaxColor,FillColor,DefaultColor : Word;
  22.     PrName     : String;
  23.  Const
  24.     NumPens = 8;  (*  plotter has this many pens *)
  25.  
  26. {$F+}
  27. function TestDetect : Integer;
  28. { Autodetect function. Assume hardware is
  29.   always present. Return value = recommended
  30.   default mode. }
  31. begin
  32.   TestDetect := 1;
  33. end;
  34. {$F-}
  35.  
  36. function Int2Str(L : LongInt) : string;
  37. { Converts an integer to a string for use with OutText, OutTextXY }
  38. var
  39.   S : string;
  40. begin
  41.   Str(L, S);
  42.   Int2Str := S;
  43. end; { Int2Str }
  44.  
  45. function RandColor : word;
  46. { Returns a Random non-zero color value that is within the legal
  47.   color range for the selected device driver and graphics mode.
  48.   MaxColor is set to GetMaxColor by Initialize }
  49. begin
  50.   RandColor := Random(MaxColor)+1;
  51. end; { RandColor }
  52.  
  53. procedure DefaultColors;
  54. { Select the maximum color in the Palette for the drawing color }
  55. begin
  56.   SetColor(MaxColor);
  57. end; { DefaultColors }
  58.  
  59. procedure PiePlay;
  60. { Demonstrate  PieSlice and GetAspectRatio commands }
  61. var
  62.   ViewInfo   : ViewPortType;
  63.   CenterX    : integer;
  64.   CenterY    : integer;
  65.   Radius     : word;
  66.   Xasp, Yasp : word;
  67.   X, Y       : integer;
  68.   HH,MM,SS,FF: Word;
  69.  
  70. function AdjAsp(Value : integer) : integer;
  71. { Adjust a value for the aspect ratio of the device }
  72. begin
  73.   AdjAsp := (LongInt(Value) * Xasp) div Yasp;
  74. end; { AdjAsp }
  75.  
  76. procedure GetTextCoords(AngleInDegrees, Radius : word; var X, Y : integer);
  77. { Get the coordinates of text for pie slice labels }
  78. var
  79.   Radians : real;
  80. begin
  81.   Radians := AngleInDegrees * Pi / 180;
  82.   X := round(Cos(Radians) * Radius);
  83.   Y := round(Sin(Radians) * Radius);
  84. end; { GetTextCoords }
  85.  
  86. begin
  87.   WriteLn('Doing Pie Chart');
  88.   GetTime(HH,MM,SS,FF);
  89.   WriteLn('Start Time > ',HH:2,':',MM:2,':',SS:2,'.',FF:2);
  90.   GetAspectRatio(Xasp, Yasp);
  91.   GetViewSettings(ViewInfo);
  92.   with ViewInfo do
  93.   begin
  94.     CenterX := (x2-x1) div 2;
  95.     CenterY := ((y2-y1) div 2) + 20;
  96.     Radius := (y2-y1) div 3;
  97.     while AdjAsp(Radius) < round((y2-y1) / 3.6) do
  98.       Inc(Radius);
  99.   end;
  100.   SetTextStyle(TriplexFont, HorizDir, 4);
  101.   SetTextJustify(CenterText, TopText);
  102.   OutTextXY(CenterX, 0, 'This is a pie chart!');
  103.   WriteLn('Title Done');
  104.   SetTextStyle(TriplexFont, HorizDir, 3);
  105.   FillColor := 2;
  106.   WriteLn('Fill color = ',FillColor);
  107.   SetFillStyle(SolidFill, FillColor);
  108.   PieSlice(CenterX+10, CenterY-AdjAsp(10), 0, 90, Radius);
  109.   GetTextCoords(45, Radius, X, Y);
  110.   SetTextJustify(LeftText, BottomText);
  111.   OutTextXY(CenterX+10+X+TextWidth('H'), CenterY-AdjAsp(10+Y), '25 %');
  112.      WriteLn('Segment Done');
  113.   FillColor := 3;
  114.   WriteLn('Fill color = ',FillColor);
  115.   SetFillStyle(LtSlashFill, FillColor);
  116.   PieSlice(CenterX, CenterY, 225, 360, Radius);
  117.   GetTextCoords(293, Radius, X, Y);
  118.   SetTextJustify(LeftText, TopText);
  119.   OutTextXY(CenterX+X+TextWidth('H'), CenterY-AdjAsp(Y), '37.5 %');
  120.      WriteLn('Segment Done');
  121.   FillColor := 4;
  122.   WriteLn('Fill color = ',FillColor);
  123.   SetFillStyle(BkSlashFill, FillColor);
  124.   PieSlice(CenterX-10, CenterY, 135, 225, Radius);
  125.   GetTextCoords(180, Radius, X, Y);
  126.   SetTextJustify(RightText, CenterText);
  127.   OutTextXY(CenterX-10+X-TextWidth('H'), CenterY-AdjAsp(Y), '25 %');
  128.      WriteLn('Segment Done');
  129.  
  130.   FillColor := 5;
  131.   WriteLn('Fill color = ',FillColor);
  132.   SetFillStyle(WideDotFill, FillColor);
  133.   PieSlice(CenterX, CenterY, 90, 135, Radius);
  134.   GetTextCoords(112, Radius, X, Y);
  135.   SetTextJustify(RightText, BottomText);
  136.   OutTextXY(CenterX+X-TextWidth('H'), CenterY-AdjAsp(Y), '12.5 %');
  137.      WriteLn('Chart Done');
  138.      GetTime(HH,MM,SS,FF);
  139.      WriteLn('End Time > ',HH:2,':',MM:2,':',SS:2,'.',FF:2);
  140. end; { PiePlay }
  141.  
  142. procedure Bar3DPlay;
  143. { Demonstrate Bar3D command }
  144. const
  145.   NumBars   = 7;  { The number of bars drawn }
  146.   BarHeight : array[1..NumBars] of byte = (1, 3, 2, 5, 4, 2, 1);
  147.   YTicks    = 5;  { The number of tick marks on the Y axis }
  148. var
  149.   ViewInfo : ViewPortType;
  150.   H        : word;
  151.   XStep    : real;
  152.   YStep    : real;
  153.   I, J     : integer;
  154.   Depth    : word;
  155.   Color    : word;
  156.   T        : Word;
  157. begin
  158.   WriteLn('3d Bar Chart');
  159.   H := 3*TextHeight('M');
  160.   T := 2*TextHeight('M');
  161.   GetViewSettings(ViewInfo);
  162.   SetTextJustify(CenterText, TopText);
  163.   SetTextStyle(TriplexFont, HorizDir, 4);
  164.   OutTextXY(MaxX div 2, T, 'These are 3D bars');
  165.   WriteLn('Title done');
  166.   SetTextStyle(SmallFont, HorizDir, 4);
  167.   with ViewInfo do
  168.     SetViewPort(x1+50, y1+40, x2-50, y2-10, ClipOn);
  169.   GetViewSettings(ViewInfo);
  170.   with ViewInfo do
  171.   begin
  172.     Line(H, H, H, (y2-y1)-H);
  173.     Line(H, (y2-y1)-H, (x2-x1)-H, (y2-y1)-H);
  174.     YStep := ((y2-y1)-(2*H)) / YTicks;
  175.     XStep := ((x2-x1)-(2*H)) / NumBars;
  176.     J := (y2-y1)-H;
  177.     SetTextJustify(CenterText, CenterText);
  178.     T := TextWidth('M');
  179.     { Draw the Y axis and ticks marks }
  180.     for I := 0 to Yticks do
  181.     begin
  182.       Line(H div 2, J, H, J);
  183.       OutTextXY(H div 2-T, J, Int2Str(I));
  184.       J := Round(J-Ystep);
  185.     end;
  186.  
  187.     WriteLn('Y Axis done');
  188.     Depth := trunc(0.25 * XStep);    { Calculate depth of bar }
  189.  
  190.     { Draw X axis, bars, and tick marks }
  191.     SetTextJustify(CenterText, TopText);
  192.     J := H;
  193.     Color := 1;
  194.     for I := 1 to Succ(NumBars) do
  195.     begin
  196.       SetColor(1);
  197.       Line(J, (y2-y1)-H, J, (y2-y1-3)-(H div 2));
  198.       OutTextXY(J, (y2-y1)-T*2, Int2Str(I-1));
  199.       WriteLn(Int2Str(I-1));
  200.       if I <> Succ(NumBars) then
  201.       begin
  202.         Color := Color + 1;
  203.         SetFillStyle(I, Color);
  204.         SetColor(Color);
  205.         Bar3D(J, round((y2-y1-H)-(BarHeight[I] * Ystep)),
  206.                  round(J+Xstep-Depth), round((y2-y1)-H-1), Depth, TopOn);
  207.         J := Round(J+Xstep);
  208.         WriteLn('Bar Done');
  209.       end;
  210.     end;
  211.      WriteLn('Chart Done');
  212.   end;
  213. end; { Bar3DPlay }
  214.  
  215.  
  216.  
  217. Procedure InitPrinter;
  218. begin
  219.   { Install the driver }
  220.     If PrName = 'HPGL' then
  221.       begin
  222.         WriteLn('Please insert paper into plotter and Press RETURN when ready');
  223.         ReadLn;
  224.         MaxColor := 1;
  225.       end;
  226.     If PrName <> 'SCREEN' then
  227.      begin
  228.       TestDriver := InstallUserDriver(PrName, @TestDetect);
  229.       if GraphResult <> grOk then
  230.         begin
  231.          WriteLn('Error installing TestDriver');
  232.          Halt(1);
  233.         end;
  234.        Driver := Detect;
  235.        WriteLn('Initializing Graphics Buffer');
  236.        InitGraph(Driver, Mode, '');
  237.        ErrCode := GraphResult;
  238.        if ErrCode <> grOk then
  239.         begin
  240.          WriteLn('Error during Init: ', ErrCode);
  241.          Halt(1);
  242.         end
  243.        else
  244.         begin
  245.           WriteLn('INIT OK');
  246.         end;
  247.      end
  248.     else
  249.      begin
  250.       Driver := Detect;
  251.       InitGraph(Driver,Mode,'');
  252.      end;
  253.  
  254.     MaxX := GetMaxX;          { Get screen resolution values }
  255.     MaxY := GetMaxY;
  256.     MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  257.     If PrName = 'HPGL' then
  258.       MaxColor := 1;
  259.     DefaultColors;
  260. end;
  261.  
  262. Procedure Intro;
  263. var Ch : Char;
  264. begin
  265.   ClrScr;
  266.   WriteLn('                               BGI Print');
  267.   WriteLn('                    Copyright (c) Bruce McAra, 1991');
  268.   WriteLn('                           All Rights Reserved');
  269.   WriteLn('                  Demonstration Program for Turbo Pascal');
  270.   WriteLn('            *************************************************** ');
  271.   WriteLn('                1. HP Laser Jet (PCL) on LPT1');
  272.   WriteLn('                2. Epson Compatible Dot Matrix on LPT1');
  273.   WriteLn('                3. HPGL Pen Plotter on COM1');
  274.   WriteLn('                4. Screen');
  275.   WriteLn;
  276.     Write('                     Select a printer Driver by Number:');
  277.   Repeat
  278.     Ch := ReadKey;
  279.     Case Ch of
  280.         '1' : PrName := 'HPPCL';
  281.         '2' : PrName := 'MATRIX';
  282.         '3' : PrName := 'HPGL';
  283.         '4' : PrName := 'SCREEN';
  284.       end;
  285.   Until Ch in ['1','2','3','4',#27];
  286.   If Ch = #27 then
  287.    begin
  288.      ClrScr;
  289.      WriteLn('Terminating program');
  290.      Halt;
  291.    end;
  292.    WriteLn;
  293.    WriteLn('Printing to ',PrName);
  294. end;
  295.  
  296. begin
  297.     If ParamCount = 1 then
  298.       PrName := ParamStr(1)
  299.     else
  300.       Intro;
  301.  
  302.     InitPrinter;
  303.     Randomize;                { init random number generator }
  304.  
  305.     PiePlay;
  306.     ReadLn;
  307.     CloseGraph;
  308.     WriteLn('Pie Chart done');
  309.     Readln;
  310.     InitPrinter;
  311.  
  312.     Bar3dPlay;
  313.     ReadLn;
  314.     Closegraph;
  315.   end.
  316.